perm filename PASTE.SAI[PIX,HPM] blob
sn#467729 filedate 1979-08-17 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "PASTE"
C00005 ENDMK
C⊗;
BEGIN "PASTE"
REQUIRE "PIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "FILHDR.SAI[VIS,HPM]" SOURCE_FILE;
INTEGER ARRAY XP,YP[1:100], IHD[1:100,0:10], IC[1:100], OHD[0:10]; INTEGER OC;
INTEGER ARRAY OLIST[1:17],OBUF[-1:120]; INTEGER OL;
STRING ARRAY FN[1:100];
INTEGER NF,FOO,I,J,K,L,NXT; STRING S;
INTEGER T,OH,OW; REAL UNITS;
PRINT("Units (pixel, in, cm):"); T←(INCHWL LAND '137);
UNITS←1;
IF T="P" THEN UNITS←1 ELSE
IF T="I" THEN UNITS←200 ELSE
IF T="C" THEN UNITS←78.74 ELSE PRINT("pixels",'15&'12);
NF←0;
WHILE TRUE DO
BEGIN "FILE NAMES"
NF←NF+1;
PRSFIL("");
DO
BEGIN
PRINT("Upleft corner, file ",NF," (Y X FILE):"); S←INCHWL;
IF LENGTH(S)=0 THEN BEGIN NF←NF-1; DONE "FILE NAMES"; END;
YP[NF]←REALSCAN(S,FOO)*UNITS; XP[NF]←REALSCAN(S,FOO)*UNITS;
FN[NF]←S[2 TO ∞];
END
UNTIL PFLDIM(FN[NF])>0;
END "FILE NAMES";
FOR I←2 STEP 1 UNTIL NF DO
FOR J←1 STEP 1 UNTIL I-1 DO
IF YP[J]>YP[I] THEN BEGIN FN[I]↔FN[J]; YP[I]↔YP[J]; XP[I]↔XP[J]; END;
PRINT("Output picture dimensions (Height, width):"); S←INCHWL;
OH←REALSCAN(S,FOO)*UNITS; OW←REALSCAN(S,FOO)*UNITS;
MAKDIM(OH,36+OW,1,OHD[0]);
PRSFIL(""); PRINT("Output file:"); OC←CREPFL(OHD[0],INCHWL);
NXT←1; OL←0;
FOR I←0 STEP 1 UNTIL OHD[PCLN]-1 DO
BEGIN
ARRCLR(OBUF);
WHILE NXT≤NF ∧ YP[NXT]=I DO
BEGIN
OLIST[OL←OL+1]←NXT;
PRSFIL("");
IC[NXT]←OPNPFL(FN[NXT],IHD[NXT,0]);
NXT←NXT+1;
END;
FOR K←1 STEP 1 UNTIL OL DO
IF YP[OLIST[K]]+IHD[OLIST[K],PCLN] = I THEN
BEGIN
PFLCLS(IC[OLIST[K]]);
OLIST[K]←OLIST[OL];
K←K-1;
OL←OL-1;
END
ELSE
PFLIN(IC[OLIST[K]],OBUF[XP[OLIST[K]]%36],IHD[OLIST[K],LNWD]);
PFLOUT(OC,OBUF[-1],OHD[LNWD]);
END;
PFLCLS(OC);
END "PASTE";